testanalysis

単年度で一度回してみましたので PostgreSQLに研究室のMacからつなげられないもんかなあ

#PostgreSQLにつなぐためのコード
require(RPostgreSQL)

## Loading required package: RPostgreSQL

## Warning: package 'RPostgreSQL' was built under R version 3.2.2

## Loading required package: DBI

## Warning: package 'DBI' was built under R version 3.2.2

con <- dbConnect(PostgreSQL(),host="localhost",user="postgres",password="fukasawa1225",dbname="db_artisoc")
bridge <- dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/19littletest'")
govern <- dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/19littletest'")

require(ggplot2)

## Loading required package: ggplot2

## Warning: package 'ggplot2' was built under R version 3.2.2

g<-ggplot(
  bridge,
  aes(
    x = day,
    y = strength,
    group = bridgeid
  )
)
g <- g + geom_line()
plot(g)

橋が全く潰れていない模様

g<-ggplot(
  govern,
  aes(
    x = day,
    y = budget
  )
)
g <- g + geom_line()
plot(g)

こんだけ直してれば予算もガリガリ減っていることだろうと思ったら全く減っておらずむしろ増えている模様 税率が高すぎる？ personのmoneyもとるべきだったなあ

personについても色々見てみましたが、橋が減ってないのでずっと同じ動きをしておりますね

はい、やり直し～

あのあと“2015/11/18littletest”,“2015/11/18bigtest”でそれぞれ0.2,0.8基準でやってみました。

取り敢えず橋の耐久値を正しく検知しない問題は解決されました「が、相変わらず政府の予算は増える一方だし、50年分やってるのに0.2にいくやつがひとつもない。ここに乗せるまでもない。ので割愛。

更に言うとbridge0はなぜか耐久値が一向に減らない。。。

橋が壊れるとかしないと、殆ど効果を測れないモデルなので、何とかして壊れて頂く必要がある。 徴税額が多すぎるのか、archive_sumが0に初期化されていないのか、橋の修復費用が低すぎるのかはよくわからないので調べないと。

取り敢えず人が橋に与える負荷はもっとおおきくしていいってことがわかった！

11/19に修正してみたモデルでの結果

bridge <- dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/19littletest'")
bridge<-bridge[,-1]
require(ggplot2)
g<-ggplot(
bridge,
aes(
x = day,
y = strength,
group = bridgeid
)
)
g <- g + geom_line()
plot(g)

bridge2 <- dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/19bigtest'")
bridge2<-bridge2[,-1]
gg1<-ggplot(
bridge2,
aes(
x = day,
y = strength,
group = bridgeid
)
)
gg1 <- gg1 + geom_line()
plot(gg1)

ほうほうといったところ せいふよさんもみてみる

govern1 <- dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/19littletest'")
govern2 <- dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/19bigtest'")
govern1<-govern1[,-1]
govern2<-govern2[,-1]
ggg1<-ggplot(
govern1,
aes(
x = day,
y = budget
)
)
ggg1 <- ggg1 + geom_line()
plot(ggg1)

gg2<-ggplot(
govern2,
aes(
x = day,
y = budget
)
)
gg2 <- gg2 + geom_line()
plot(gg2)

政府予算はやはりまるでへっていないので何とかしないと 最後に政府予算を半分の50億から始めた場合

bridge3 <- dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/19littlebudgethalftest'")
govern3 <- dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/19littlebudgethalftest'")
bridge3<-bridge3[,-1]
govern3<-govern3[,-1]
g3<-ggplot(
bridge3,
aes(
x = day,
y = strength,
group = bridgeid
)
)
g3 <- g3 + geom_line()
plot(g3)

gg3<-ggplot(
govern3,
aes(
x = day,
y = budget
)
)
gg3 <- gg3 + geom_line()
plot(gg3)

うん、これ橋の修繕費が低すぎるか徴税額が多すぎるのかどっちかだな

person3 <- dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/19littlebudgethalftest'")
gp<-ggplot(
person3,
aes(
x = day,
y = money,
group=personid
)
)
gp <- gp + geom_line()
plot(gp)

橋の修繕に費用が掛かっていなかったことが原因の模様

ということで修正したのがコード“2015/11/20littletest”

 br<- dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/20littletest'")
 go<- dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/20littletest'")
 pe<- dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/20littletest'")

# PostgreSQLとリモートで繋げられるようになったらね

gbr<-ggplot(
br,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
br,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

橋は4本だけ直されたようですな しかも5番さんが直されていない。。。 あとdemandの処理を見直す必要がある 一年ごとに0になるのと、耐久値が規定値以下になったら通れなくなって自分自身のdemandは常に0にしないとね

通れなくなった橋はフラグ

では続きまして政府予算です

ggo<-ggplot(
go,
aes(
x = day,
y = budget
)
)
ggo <- ggo + geom_line()
plot(ggo)

ほうほうほうほうといったところ 50億ではかなりきつそうだなあというところ　

もっとがくんがくんとしてるのを想像したんだけどなあ ちゃんと人々は効用が落ちているのかを確認する

gp<-ggplot(
pe,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

# 全体だと意味がわからんのですが、、、
gp<-ggplot(
subset(pe,personid==0),
aes(
x = day,
y = utilize
)
)
gp <- gp + geom_line()
plot(gp)

このあと個別に見たけど、そんなに効用や移動時間が大きく変化しているとは言い難い状況である。 うーむ。

フラグ立てたり、positivelineいれたり、余暇の取り扱いを替えたのが“2015/11/21littletest”

 br<- dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/21littletest'")
 go<- dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/21littletest'")
 pe<- dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/21littletest'")

# まずは橋から見てみる
gbr<-ggplot(
br,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
br,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

いつも思うけど、人が通ったことによる耐久値の揺らぎが見られない気がしてならない 多分直さないといけない部分

demandは次の書き方で個別の橋について見てみたらちゃんと通れないようになっているのが分かった

gbr1<-ggplot(
subset(br,bridgeid==0),
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

0番が急に利用されているのが分かるのはいいもんだね collapseフラグで見るとはっきりわかるよ

結局subsetで見たんですけどね 壊れた橋は順番に 6(7590日目),4(11910日目),9(13350日目),5(14430日目) これと合わせて政府予算を見てみるよ っていうか政府予算と各橋の修繕費用を比較してみないといけないから、費用が分かるようにしないと まあ後で価値を掛け算すればいいだけか

goo<-ggplot(
go,
aes(
x = day,
y = budget
)
)
goo <- goo + geom_line()
plot(goo)

gp<-ggplot(
pe,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
pe,
aes(
x = day,
y = freetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
pe,
aes(
x = day,
y = movetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
pe,
aes(
x = day,
y = consumtion,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
pe,
aes(
x = day,
y = money,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

positivelineとnegativelineの出力も必要やなと

ではここでconsumtionとfreetimeの平均と分散を出してみたいと思います

summary(pe$freetime)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0    3136    4508    4719    6064   14480

summary(pe$consumtion)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0  120200  152200  155100  191000  405600

summary(pe$movetime)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    2920    3030    3032    3033    3037    3057

sd(pe$freetime)

## [1] 2171.208

sd(pe$consumtion)

## [1] 53864.14

sd(pe$movetime)

## [1] 8.085612

ということでこの標準偏差に更新し直します

11/22は三回ほど計算を行いました まとめてみていきましょう

b1<-dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/22bigtest'")
b2<-dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/22littletesthyakuoku'")
b3<-dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/22bigtesthyakuoku'")
g1<-dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/22bigtest'")
g2<-dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/22littletesthyakuoku'")
g3<-dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/22bigtesthyakuoku'")
p1<-dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/22bigtest'")
p2<-dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/22littletesthyakuoku'")
p3<-dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/22bigtesthyakuoku'")

2015/11/22bigtest

# まずは橋から見てみる
gbr<-ggplot(
b1,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
b1,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

な、なんで一つも橋が直されていないのだ。。。 壊れたのは5番のみの模様 修繕費用が政府予算を大きく上回っていたのか？

ggo<-ggplot(
g1,
aes(
x = day,
y = budget
)
)
ggo<- ggo + geom_line()
plot(ggo)

政府予算とrepaicostを見比べてみても直されない理由が見つからない うーん？

gp<-ggplot(
p1,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = freetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = movetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = consumtion,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = money,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

utilizeがマイナスになっているので、freetimeとかの標準偏差がおかしいことに気づく 計算します

pinfo<-matrix(c(1,1,1),nrow = 1)
pinfo<-data.frame(pinfo)
names(pinfo)<-c("f","m","c")
for (i in 0:19){
  temp<-subset(p1,personid==i)
  f<-sd(temp$freetime)
  m<-sd(temp$movetime)
  c<-sd(temp$consumtion)
  pinfo<-rbind(pinfo,c(f,m,c))
}
pinfo<-pinfo[-1,]
mean(pinfo$f)

## [1] 1599.453

mean(pinfo$m)

## [1] 4.744876

mean(pinfo$c)

## [1] 49399.96

ということなので、1605.13,4.72,49905.17で更新し直します 前回計算した標準偏差とかはdayとかidとかが一緒くただったことが原因で少しずれていたのかもしれない？ とりあえず50億はこの世界にとってかつかつの予算なのかもしれない

続いて同日のlittletesthyakuoku こちらは予算が百億 一気に行きますぞ

gbr<-ggplot(
b2,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
b2,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

ggo<-ggplot(
g2,
aes(
x = day,
y = budget
)
)
ggo<- ggo + geom_line()
plot(ggo)

gp<-ggplot(
p2,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = freetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = movetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = consumtion,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = money,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

問題として、橋が少なくなっても移動時間にあまり差が出ていないという それによって効用に与える変化量がなかなかつかめない

行き先が固定化されていれば、いくらか影響が出て来やすくなるのかもしれない オフィスの行き先を固定化しよう

最後に一応bigtesthyakuokuを確認する

gbr<-ggplot(
b3,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
b3,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

ggo<-ggplot(
g3,
aes(
x = day,
y = budget
)
)
ggo<- ggo + geom_line()
plot(ggo)

gp<-ggplot(
p3,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p3,
aes(
x = day,
y = freetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p3,
aes(
x = day,
y = movetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p3,
aes(
x = day,
y = consumtion,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p3,
aes(
x = day,
y = money,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

これも5番しか壊れてない

for (i in 0:19){
  temp<-subset(p3,personid==i)
  f<-sd(temp$freetime)
  m<-sd(temp$movetime)
  c<-sd(temp$consumtion)
  pinfo<-rbind(pinfo,c(f,m,c))
}
pinfo<-pinfo[-1,]
mean(pinfo$f)

## [1] 1525.567

mean(pinfo$m)

## [1] 4.780883

mean(pinfo$c)

## [1] 48966.63

いろいろ固定化したりしてみたのが23日

b2<-dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/23bigtesthyakuoku'")
b1<-dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/23littletesthyakuoku'")
g2<-dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/23bigtesthyakuoku'")
g1<-dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/23littletesthyakuoku'")
p2<-dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/23bigtesthyakuoku'")
p1<-dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/23littletesthyakuoku'")

littletesthyakuoku

gbr<-ggplot(
b1,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
b1,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

gp<-ggplot(
p1,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = freetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = movetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = consumtion,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = money,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

bigtesthyakuoku

gbr<-ggplot(
b2,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
b2,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

ggo<-ggplot(
g2,
aes(
x = day,
y = budget
)
)
ggo<- ggo + geom_line()
plot(ggo)

gp<-ggplot(
p2,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = freetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = movetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = consumtion,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = money,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

＊costが100000にupdateされているなら、strengthを0にしてわかりやすくする ＊bridgeid5の修繕費用がさすがに高すぎるので、長さを100mにする ＊人々の効用が橋の数が少なくなったことを受けても一向に減らないので、もう少し下限を小さくする

次は2015/11/24/little(big)testhyakuokummです

b2<-dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/24bigtesthyakuokumm'")
b1<-dbGetQuery(con,"SELECT * FROM bridgelog where simulationcode ='2015/11/24littletesthyakuokumm'")
g2<-dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/24bigtesthyakuokumm'")
g1<-dbGetQuery(con,"SELECT * FROM governmentlog where simulationcode ='2015/11/24littletesthyakuokumm'")
p2<-dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/24bigtesthyakuokumm'")
p1<-dbGetQuery(con,"SELECT * FROM personlog where simulationcode ='2015/11/24littletesthyakuokumm'")

littletesthyakuokumm

gbr<-ggplot(
b1,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
b1,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
ggo<-ggplot(
g1,
aes(
x = day,
y = budget
)
)
ggo<- ggo + geom_line()
plot(ggo)

gbr1 <- gbr1 + geom_line()
plot(gbr1)

gp<-ggplot(
p1,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = freetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = movetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = consumtion,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p1,
aes(
x = day,
y = money,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

bigtesthyakuokumm

gbr<-ggplot(
b2,
aes(
x = day,
y = strength,
colour=factor(bridgeid)
)
)
gbr <- gbr + geom_line()
plot(gbr)

gbr1<-ggplot(
b2,
aes(
x = day,
y = demand,
colour=factor(bridgeid)
)
)
gbr1 <- gbr1 + geom_line()
plot(gbr1)

ggo<-ggplot(
g2,
aes(
x = day,
y = budget
)
)
ggo<- ggo + geom_line()
plot(ggo)

gp<-ggplot(
p2,
aes(
x = day,
y = utilize,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = freetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = movetime,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = consumtion,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)

gp<-ggplot(
p2,
aes(
x = day,
y = money,
colour=factor(personid)
)
)
gp <- gp + geom_line()
plot(gp)